home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / share / multimed / myflix_win32 / data1.cab / Libraries / tk8.0 / Listbox.tcl < prev    next >
Encoding:
Text File  |  1998-03-10  |  11.4 KB  |  453 lines
  1. # listbox.tcl --
  2. #
  3. # This file defines the default bindings for Tk listbox widgets
  4. # and provides procedures that help in implementing those bindings.
  5. #
  6. # SCCS: @(#) listbox.tcl 1.21 97/06/10 17:13:55
  7. #
  8. # Copyright (c) 1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  
  14. #--------------------------------------------------------------------------
  15. # tkPriv elements used in this file:
  16. #
  17. # afterId -        Token returned by "after" for autoscanning.
  18. # listboxPrev -        The last element to be selected or deselected
  19. #            during a selection operation.
  20. # listboxSelection -    All of the items that were selected before the
  21. #            current selection operation (such as a mouse
  22. #            drag) started;  used to cancel an operation.
  23. #--------------------------------------------------------------------------
  24.  
  25. #-------------------------------------------------------------------------
  26. # The code below creates the default class bindings for listboxes.
  27. #-------------------------------------------------------------------------
  28.  
  29. # Note: the check for existence of %W below is because this binding
  30. # is sometimes invoked after a window has been deleted (e.g. because
  31. # there is a double-click binding on the widget that deletes it).  Users
  32. # can put "break"s in their bindings to avoid the error, but this check
  33. # makes that unnecessary.
  34.  
  35. bind Listbox <1> {
  36.     if [winfo exists %W] {
  37.     tkListboxBeginSelect %W [%W index @%x,%y]
  38.     }
  39. }
  40.  
  41. # Ignore double clicks so that users can define their own behaviors.
  42. # Among other things, this prevents errors if the user deletes the
  43. # listbox on a double click.
  44.  
  45. bind Listbox <Double-1> {
  46.     # Empty script
  47. }
  48.  
  49. bind Listbox <B1-Motion> {
  50.     set tkPriv(x) %x
  51.     set tkPriv(y) %y
  52.     tkListboxMotion %W [%W index @%x,%y]
  53. }
  54. bind Listbox <ButtonRelease-1> {
  55.     tkCancelRepeat
  56.     %W activate @%x,%y
  57. }
  58. bind Listbox <Shift-1> {
  59.     tkListboxBeginExtend %W [%W index @%x,%y]
  60. }
  61. bind Listbox <Control-1> {
  62.     tkListboxBeginToggle %W [%W index @%x,%y]
  63. }
  64. bind Listbox <B1-Leave> {
  65.     set tkPriv(x) %x
  66.     set tkPriv(y) %y
  67.     tkListboxAutoScan %W
  68. }
  69. bind Listbox <B1-Enter> {
  70.     tkCancelRepeat
  71. }
  72.  
  73. bind Listbox <Up> {
  74.     tkListboxUpDown %W -1
  75. }
  76. bind Listbox <Shift-Up> {
  77.     tkListboxExtendUpDown %W -1
  78. }
  79. bind Listbox <Down> {
  80.     tkListboxUpDown %W 1
  81. }
  82. bind Listbox <Shift-Down> {
  83.     tkListboxExtendUpDown %W 1
  84. }
  85. bind Listbox <Left> {
  86.     %W xview scroll -1 units
  87. }
  88. bind Listbox <Control-Left> {
  89.     %W xview scroll -1 pages
  90. }
  91. bind Listbox <Right> {
  92.     %W xview scroll 1 units
  93. }
  94. bind Listbox <Control-Right> {
  95.     %W xview scroll 1 pages
  96. }
  97. bind Listbox <Prior> {
  98.     %W yview scroll -1 pages
  99.     %W activate @0,0
  100. }
  101. bind Listbox <Next> {
  102.     %W yview scroll 1 pages
  103.     %W activate @0,0
  104. }
  105. bind Listbox <Control-Prior> {
  106.     %W xview scroll -1 pages
  107. }
  108. bind Listbox <Control-Next> {
  109.     %W xview scroll 1 pages
  110. }
  111. bind Listbox <Home> {
  112.     %W xview moveto 0
  113. }
  114. bind Listbox <End> {
  115.     %W xview moveto 1
  116. }
  117. bind Listbox <Control-Home> {
  118.     %W activate 0
  119.     %W see 0
  120.     %W selection clear 0 end
  121.     %W selection set 0
  122. }
  123. bind Listbox <Shift-Control-Home> {
  124.     tkListboxDataExtend %W 0
  125. }
  126. bind Listbox <Control-End> {
  127.     %W activate end
  128.     %W see end
  129.     %W selection clear 0 end
  130.     %W selection set end
  131. }
  132. bind Listbox <Shift-Control-End> {
  133.     tkListboxDataExtend %W [%W index end]
  134. }
  135. bind Listbox <<Copy>> {
  136.     if {[selection own -displayof %W] == "%W"} {
  137.     clipboard clear -displayof %W
  138.     clipboard append -displayof %W [selection get -displayof %W]
  139.     }
  140. }
  141. bind Listbox <space> {
  142.     tkListboxBeginSelect %W [%W index active]
  143. }
  144. bind Listbox <Select> {
  145.     tkListboxBeginSelect %W [%W index active]
  146. }
  147. bind Listbox <Control-Shift-space> {
  148.     tkListboxBeginExtend %W [%W index active]
  149. }
  150. bind Listbox <Shift-Select> {
  151.     tkListboxBeginExtend %W [%W index active]
  152. }
  153. bind Listbox <Escape> {
  154.     tkListboxCancel %W
  155. }
  156. bind Listbox <Control-slash> {
  157.     tkListboxSelectAll %W
  158. }
  159. bind Listbox <Control-backslash> {
  160.     if {[%W cget -selectmode] != "browse"} {
  161.     %W selection clear 0 end
  162.     }
  163. }
  164.  
  165. # Additional Tk bindings that aren't part of the Motif look and feel:
  166.  
  167. bind Listbox <2> {
  168.     %W scan mark %x %y
  169. }
  170. bind Listbox <B2-Motion> {
  171.     %W scan dragto %x %y
  172. }
  173.  
  174. # tkListboxBeginSelect --
  175. #
  176. # This procedure is typically invoked on button-1 presses.  It begins
  177. # the process of making a selection in the listbox.  Its exact behavior
  178. # depends on the selection mode currently in effect for the listbox;
  179. # see the Motif documentation for details.
  180. #
  181. # Arguments:
  182. # w -        The listbox widget.
  183. # el -        The element for the selection operation (typically the
  184. #        one under the pointer).  Must be in numerical form.
  185.  
  186. proc tkListboxBeginSelect {w el} {
  187.     global tkPriv
  188.     if {[$w cget -selectmode]  == "multiple"} {
  189.     if [$w selection includes $el] {
  190.         $w selection clear $el
  191.     } else {
  192.         $w selection set $el
  193.     }
  194.     } else {
  195.     $w selection clear 0 end
  196.     $w selection set $el
  197.     $w selection anchor $el
  198.     set tkPriv(listboxSelection) {}
  199.     set tkPriv(listboxPrev) $el
  200.     }
  201. }
  202.  
  203. # tkListboxMotion --
  204. #
  205. # This procedure is called to process mouse motion events while
  206. # button 1 is down.  It may move or extend the selection, depending
  207. # on the listbox's selection mode.
  208. #
  209. # Arguments:
  210. # w -        The listbox widget.
  211. # el -        The element under the pointer (must be a number).
  212.  
  213. proc tkListboxMotion {w el} {
  214.     global tkPriv
  215.     if {$el == $tkPriv(listboxPrev)} {
  216.     return
  217.     }
  218.     set anchor [$w index anchor]
  219.     switch [$w cget -selectmode] {
  220.     browse {
  221.         $w selection clear 0 end
  222.         $w selection set $el
  223.         set tkPriv(listboxPrev) $el
  224.     }
  225.     extended {
  226.         set i $tkPriv(listboxPrev)
  227.         if [$w selection includes anchor] {
  228.         $w selection clear $i $el
  229.         $w selection set anchor $el
  230.         } else {
  231.         $w selection clear $i $el
  232.         $w selection clear anchor $el
  233.         }
  234.         while {($i < $el) && ($i < $anchor)} {
  235.         if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
  236.             $w selection set $i
  237.         }
  238.         incr i
  239.         }
  240.         while {($i > $el) && ($i > $anchor)} {
  241.         if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
  242.             $w selection set $i
  243.         }
  244.         incr i -1
  245.         }
  246.         set tkPriv(listboxPrev) $el
  247.     }
  248.     }
  249. }
  250.  
  251. # tkListboxBeginExtend --
  252. #
  253. # This procedure is typically invoked on shift-button-1 presses.  It
  254. # begins the process of extending a selection in the listbox.  Its
  255. # exact behavior depends on the selection mode currently in effect
  256. # for the listbox;  see the Motif documentation for details.
  257. #
  258. # Arguments:
  259. # w -        The listbox widget.
  260. # el -        The element for the selection operation (typically the
  261. #        one under the pointer).  Must be in numerical form.
  262.  
  263. proc tkListboxBeginExtend {w el} {
  264.     if {[$w cget -selectmode] == "extended"} {
  265.     if {[$w selection includes anchor]} {
  266.         tkListboxMotion $w $el
  267.     } else {
  268.         # No selection yet; simulate the begin-select operation.
  269.  
  270.         tkListboxBeginSelect $w $el
  271.     }
  272.     }
  273. }
  274.  
  275. # tkListboxBeginToggle --
  276. #
  277. # This procedure is typically invoked on control-button-1 presses.  It
  278. # begins the process of toggling a selection in the listbox.  Its
  279. # exact behavior depends on the selection mode currently in effect
  280. # for the listbox;  see the Motif documentation for details.
  281. #
  282. # Arguments:
  283. # w -        The listbox widget.
  284. # el -        The element for the selection operation (typically the
  285. #        one under the pointer).  Must be in numerical form.
  286.  
  287. proc tkListboxBeginToggle {w el} {
  288.     global tkPriv
  289.     if {[$w cget -selectmode] == "extended"} {
  290.     set tkPriv(listboxSelection) [$w curselection]
  291.     set tkPriv(listboxPrev) $el
  292.     $w selection anchor $el
  293.     if [$w selection includes $el] {
  294.         $w selection clear $el
  295.     } else {
  296.         $w selection set $el
  297.     }
  298.     }
  299. }
  300.  
  301. # tkListboxAutoScan --
  302. # This procedure is invoked when the mouse leaves an entry window
  303. # with button 1 down.  It scrolls the window up, down, left, or
  304. # right, depending on where the mouse left the window, and reschedules
  305. # itself as an "after" command so that the window continues to scroll until
  306. # the mouse moves back into the window or the mouse button is released.
  307. #
  308. # Arguments:
  309. # w -        The entry window.
  310.  
  311. proc tkListboxAutoScan {w} {
  312.     global tkPriv
  313.     if {![winfo exists $w]} return
  314.     set x $tkPriv(x)
  315.     set y $tkPriv(y)
  316.     if {$y >= [winfo height $w]} {
  317.     $w yview scroll 1 units
  318.     } elseif {$y < 0} {
  319.     $w yview scroll -1 units
  320.     } elseif {$x >= [winfo width $w]} {
  321.     $w xview scroll 2 units
  322.     } elseif {$x < 0} {
  323.     $w xview scroll -2 units
  324.     } else {
  325.     return
  326.     }
  327.     tkListboxMotion $w [$w index @$x,$y]
  328.     set tkPriv(afterId) [after 50 tkListboxAutoScan $w]
  329. }
  330.  
  331. # tkListboxUpDown --
  332. #
  333. # Moves the location cursor (active element) up or down by one element,
  334. # and changes the selection if we're in browse or extended selection
  335. # mode.
  336. #
  337. # Arguments:
  338. # w -        The listbox widget.
  339. # amount -    +1 to move down one item, -1 to move back one item.
  340.  
  341. proc tkListboxUpDown {w amount} {
  342.     global tkPriv
  343.     $w activate [expr [$w index active] + $amount]
  344.     $w see active
  345.     switch [$w cget -selectmode] {
  346.     browse {
  347.         $w selection clear 0 end
  348.         $w selection set active
  349.     }
  350.     extended {
  351.         $w selection clear 0 end
  352.         $w selection set active
  353.         $w selection anchor active
  354.         set tkPriv(listboxPrev) [$w index active]
  355.         set tkPriv(listboxSelection) {}
  356.     }
  357.     }
  358. }
  359.  
  360. # tkListboxExtendUpDown --
  361. #
  362. # Does nothing unless we're in extended selection mode;  in this
  363. # case it moves the location cursor (active element) up or down by
  364. # one element, and extends the selection to that point.
  365. #
  366. # Arguments:
  367. # w -        The listbox widget.
  368. # amount -    +1 to move down one item, -1 to move back one item.
  369.  
  370. proc tkListboxExtendUpDown {w amount} {
  371.     if {[$w cget -selectmode] != "extended"} {
  372.     return
  373.     }
  374.     $w activate [expr [$w index active] + $amount]
  375.     $w see active
  376.     tkListboxMotion $w [$w index active]
  377. }
  378.  
  379. # tkListboxDataExtend
  380. #
  381. # This procedure is called for key-presses such as Shift-KEndData.
  382. # If the selection mode isn't multiple or extend then it does nothing.
  383. # Otherwise it moves the active element to el and, if we're in
  384. # extended mode, extends the selection to that point.
  385. #
  386. # Arguments:
  387. # w -        The listbox widget.
  388. # el -        An integer element number.
  389.  
  390. proc tkListboxDataExtend {w el} {
  391.     set mode [$w cget -selectmode]
  392.     if {$mode == "extended"} {
  393.     $w activate $el
  394.     $w see $el
  395.         if [$w selection includes anchor] {
  396.         tkListboxMotion $w $el
  397.     }
  398.     } elseif {$mode == "multiple"} {
  399.     $w activate $el
  400.     $w see $el
  401.     }
  402. }
  403.  
  404. # tkListboxCancel
  405. #
  406. # This procedure is invoked to cancel an extended selection in
  407. # progress.  If there is an extended selection in progress, it
  408. # restores all of the items between the active one and the anchor
  409. # to their previous selection state.
  410. #
  411. # Arguments:
  412. # w -        The listbox widget.
  413.  
  414. proc tkListboxCancel w {
  415.     global tkPriv
  416.     if {[$w cget -selectmode] != "extended"} {
  417.     return
  418.     }
  419.     set first [$w index anchor]
  420.     set last $tkPriv(listboxPrev)
  421.     if {$first > $last} {
  422.     set tmp $first
  423.     set first $last
  424.     set last $tmp
  425.     }
  426.     $w selection clear $first $last
  427.     while {$first <= $last} {
  428.     if {[lsearch $tkPriv(listboxSelection) $first] >= 0} {
  429.         $w selection set $first
  430.     }
  431.     incr first
  432.     }
  433. }
  434.  
  435. # tkListboxSelectAll
  436. #
  437. # This procedure is invoked to handle the "select all" operation.
  438. # For single and browse mode, it just selects the active element.
  439. # Otherwise it selects everything in the widget.
  440. #
  441. # Arguments:
  442. # w -        The listbox widget.
  443.  
  444. proc tkListboxSelectAll w {
  445.     set mode [$w cget -selectmode]
  446.     if {($mode == "single") || ($mode == "browse")} {
  447.     $w selection clear 0 end
  448.     $w selection set active
  449.     } else {
  450.     $w selection set 0 end
  451.     }
  452. }
  453.